home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_18_1987_Transactor_Publishing.d64 / fast sqr.pal (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  2KB  |  93 lines
  1. 100 rem faster square root pal source
  2. 110 open8,8,1,"0:fast sqr.obj
  3. 120 [158] 700
  4. 130 .opt o8
  5. 140 [172][178] $c000
  6. 150 ; faster square root
  7. 160 ; takes first basic variable [175]
  8. 170 ; [142]s square root in its place
  9. 180 ; uses [162][164]n's method with a [203]od
  10. 190 ; first approximati[145].
  11. 200 ;
  12. 210 var [178] $2d ; start of variables
  13. 220 ptr [178] $aa ; po[181]s [164] variable
  14. 230 ctr [178] $ac ; iterati[145] counter
  15. 240 temp [178] $5c ; temp s[164]re [129] flt pt #
  16. 250 ;
  17. 260 ; rom routines
  18. 270 temf1 [178] $bba2 ; unpack 5c [164] fac#1
  19. 280 divid [178] $bb0f ; fac#1[178]var[173]fac#1
  20. 290 plus [178] $b867  ;fac#1[178]fac#2[170]fac#1
  21. 300 f1tem [178] $bbc7 ; pack fac#1 [164] 5c
  22. 310 f1mem [178] $bbd4 ; pack fac#1 [164] mem[176]y
  23. 320 [153] [178] $ffd2 ; chrout routine
  24. 330 ;
  25. 340 ldy #$03    ;[161] variable's mantissa
  26. 350 lda (var),y ;check [139] negative
  27. 360 bmi err[176]exit
  28. 370 dey
  29. 380 lda (var),y ;[161] variable's [189][145]ent
  30. 390 beq [142]  ;[142] [139] var[178]zero
  31. 400 lda var     ;po[181]s [164] var name
  32. 410 clc
  33. 420 adc #$02    ;add 2 so ptr
  34. 430 sta ptr     ;po[181]s [164] variable
  35. 440 lda var[170]1   ;[175] s[164]re it
  36. 450 adc #$00
  37. 460 sta ptr[170]1
  38. 470 ldy #$0     ;fill temp with zeroes
  39. 480 sty temp[170]1
  40. 490 sty temp[170]2
  41. 500 sty temp[170]3
  42. 510 sty temp[170]4
  43. 520 ;
  44. 530 ; now find a first approximati[145]
  45. 540 ; [164] the square root
  46. 550 ; [189][145]ent[178]  [189][145]ent[173]2 [170]40.5
  47. 560 ; mantissa found from table
  48. 570 lda (ptr),y ;[161] [189][145]ent  (y[178]0)
  49. 580 r[176]        ;a[178]a[173]a, pop low bit
  50. 590 ;   carry[178]1 when [189][145]ent odd
  51. 600 bcs add    ;no flag set [139] odd
  52. 610 ldx #$80   ;even, so set a flag bit
  53. 620 stx temp[170]1
  54. 630 add adc #$40 ;a[178][189][145]ent of 1st appr
  55. 640 sta temp   ;s[164]re [189][145]ent
  56. 650 iny        ;y[178]1
  57. 660 lda (ptr),y ;mantissa of variable
  58. 670 [176]a temp[170]1 ;[139] [189][145] odd add 80
  59. 680 lsr            ;sh[139]t nybble right
  60. 690 lsr
  61. 700 lsr
  62. 710 lsr
  63. 720 tax
  64. 730 lda tabl,x ;[161] approx from table
  65. 740 sta temp[170]1 ;s[164]re it in temp mantissa
  66. 750 ; now use [162][164]n's method
  67. 760 ; x[178](x[170]var[173]x)[173]2
  68. 770 lda #$04
  69. 780 sta ctr   ;set counter [164] 4
  70. 790 lda #[179]temp
  71. 800 ldy #0
  72. 810 jsr temf1 ;[147] fac#1 from temp
  73. 820 loop lda ptr
  74. 830 ldy ptr[170]1
  75. 840 jsr divid ;divide fac#1 [181]o var
  76. 850 lda #[179]temp
  77. 860 ldy #0
  78. 870 jsr plus  ;add temp [164] fac#1
  79. 880 dec $61   ;divide fac#1 by 2
  80. 890 jsr f1tem ;pack fac#1 [164] temp
  81. 900 dec ctr   ;dec[143]ent the counter
  82. 910 bne loop  ;loop [139] [168] zero
  83. 920 ldx ptr
  84. 930 ldy ptr[170]1
  85. 940 jsr f1mem ;pack fac#1 [164] mem[176]y
  86. 950 [142] rts
  87. 960 err[176]exit lda #$3f ; "?"
  88. 970 jsr [153]          ;[153] "?"
  89. 980 rts
  90. 990 tabl .byte 03,11,18,25,32,38,44,50
  91. 1000 .byte 58,69,79,89,98,107,115,123
  92. 1010 .[128]
  93.